home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-03 / bardcol1.zip / BARDCOL.INC < prev   
Text File  |  1991-04-06  |  10KB  |  332 lines
  1. 'LScroll and RScroll are handy routines I found in Compuserve's TB Library
  2. 'both are written by Ethan Winer and work without modification in PB 2.1
  3.  
  4. 'LScroll - Scroll a part of the screen left
  5. 'Example:  CALL LScroll (TopRow%, LeftCol%, BotRow%, RightCol%, Lines%)
  6.  
  7. SUB LScroll INLINE PUBLIC
  8. $INLINE &H55,&H1E,&H8B,&HEC,&H8B,&H76,&H18,&H8E,&H5E,&H1A,&H8A,&H04,&HFE,&HC8
  9. $INLINE &HB1,&HA0,&HF6,&HE1,&H8B,&H76,&H14,&H8E,&H5E,&H16,&H8B,&H1C,&H4B,&H03
  10. $INLINE &HC3,&H03,&HC3,&H8B,&HD8,&H8B,&H76,&H08,&H8E,&H5E,&H0A,&H2B,&H1C,&H2B
  11. $INLINE &H1C,&HB9,&H00,&H00,&H8E,&HC1,&HB9,&H00,&HB0,&H26,&H8A,&H16,&H10,&H04
  12. $INLINE &H80,&HE2,&H30,&H80,&HFA,&H30,&H74,&H14,&H81,&HC1,&H00,&H08,&H26,&H8A
  13. $INLINE &H16,&H87,&H04,&H80,&HFA,&H00,&H75,&H06,&HBA,&HDA,&H03,&HEB,&H04,&H90
  14. $INLINE &HBA,&H00,&H00,&H8E,&HC1,&H8B,&H76,&H10,&H8E,&H5E,&H12,&H8A,&H2C,&H8B
  15. $INLINE &H76,&H18,&H8E,&H5E,&H1A,&H2A,&H2C,&HFE,&HC5,&H8B,&H76,&H0C,&H8E,&H5E
  16. $INLINE &H0E,&H8A,&H0C,&H8B,&H76,&H14,&H8E,&H5E,&H16,&H2A,&H0C,&HFE,&HC1,&H06
  17. $INLINE &H1F,&HFC,&H8B,&HF0,&H8B,&HFB,&H50,&H80,&HFA,&H00,&H74,&H0A,&HEC,&HA8
  18. $INLINE &H01,&H75,&HFB,&HEC,&HA8,&H01,&H74,&HFB,&HAD,&HAB,&HFE,&HC9,&H75,&HEB
  19. $INLINE &H58,&H50,&H2B,&HC3,&HD0,&HE8,&H8A,&HC8,&H58,&H50,&H2B,&HF0,&H8B,&HC6
  20. $INLINE &HD0,&HE8,&H8A,&HE0,&H80,&HFA,&H00,&H74,&H0A,&HEC,&HA8,&H01,&H75,&HFB
  21. $INLINE &HEC,&HA8,&H01,&H74,&HFB,&HB0,&H20,&HAA,&H47,&HFE,&HC9,&H75,&HE9,&H8A
  22. $INLINE &HCC,&H58,&H05,&HA0,&H00,&H81,&HC3,&HA0,&H00,&HFE,&HCD,&H75,&HAF,&H1F
  23. $INLINE &H5D
  24. END SUB
  25.  
  26. 'RScroll - Scroll a part of the screen right
  27. 'Example: CALL RScroll(TopRow%, LeftCol%, BotRow%, RightCol%, Lines%)
  28.  
  29. SUB RScroll INLINE PUBLIC
  30. $INLINE &H55,&H1E,&H8B,&HEC,&H8B,&H76,&H18,&H8E,&H5E,&H1A,&H8A,&H04,&HFE,&HC8
  31. $INLINE &HB1,&HA0,&HF6,&HE1,&H8B,&H76,&H0C,&H8E,&H5E,&H0E,&H8B,&H1C,&H4B,&H03
  32. $INLINE &HC3,&H03,&HC3,&H8B,&HD8,&H8B,&H76,&H08,&H8E,&H5E,&H0A,&H03,&H1C,&H03
  33. $INLINE &H1C,&HB9,&H00,&H00,&H8E,&HC1,&HB9,&H00,&HB0,&H26,&H8A,&H16,&H10,&H04
  34. $INLINE &H80,&HE2,&H30,&H80,&HFA,&H30,&H74,&H14,&H81,&HC1,&H00,&H08,&H26,&H8A
  35. $INLINE &H16,&H87,&H04,&H80,&HFA,&H00,&H75,&H06,&HBA,&HDA,&H03,&HEB,&H04,&H90
  36. $INLINE &HBA,&H00,&H00,&H8E,&HC1,&H8B,&H76,&H10,&H8E,&H5E,&H12,&H8A,&H2C,&H8B
  37. $INLINE &H76,&H18,&H8E,&H5E,&H1A,&H2A,&H2C,&HFE,&HC5,&H8B,&H76,&H0C,&H8E,&H5E
  38. $INLINE &H0E,&H8A,&H0C,&H8B,&H76,&H14,&H8E,&H5E,&H16,&H2A,&H0C,&HFE,&HC1,&H06
  39. $INLINE &H1F,&HFD,&H8B,&HF0,&H8B,&HFB,&H50,&H80,&HFA,&H00,&H74,&H0A,&HEC,&HA8
  40. $INLINE &H01,&H75,&HFB,&HEC,&HA8,&H01,&H74,&HFB,&HAD,&HAB,&HFE,&HC9,&H75,&HEB
  41. $INLINE &H58,&H50,&H53,&H2B,&HD8,&HD0,&HEB,&H8A,&HCB,&H5B,&H58,&H50,&H2B,&HC6
  42. $INLINE &HD0,&HE8,&H8A,&HE0,&H80,&HFA,&H00,&H74,&H0A,&HEC,&HA8,&H01,&H75,&HFB
  43. $INLINE &HEC,&HA8,&H01,&H74,&HFB,&HB0,&H20,&HAA,&H4F,&HFE,&HC9,&H75,&HE9,&H8A
  44. $INLINE &HCC,&H58,&H05,&HA0,&H00,&H81,&HC3,&HA0,&H00,&HFE,&HCD,&H75,&HAF,&H1F
  45. $INLINE &H5D
  46. END SUB
  47.  
  48. 'CompId% is a conversion I did from a misc BASICA example
  49.  
  50. 'CompId% - Determines the type of computer being used
  51. '             0 - Type is undetermined.  The computer could be a "clone"
  52. '                 which does not have a 100% compatible BIOS.
  53. '             1 - AT or compatible, including 386, or PS/2 Model 50/60
  54. '             2 - PC Jr.
  55. '             3 - XT, portable, or compatible
  56. '             4 - PC or compatible
  57. '         -1 - PS/2 Model 25 or Model 30
  58. '         -3 - PS/2 Model 80
  59.  
  60. FUNCTION CompId%
  61.     DEF SEG = &HF000
  62.     Machine% = PEEK(&HFFFE)
  63.     DEF SEG
  64.     ComputerType% = Machine% - 251
  65.     IF ComputerType% > 4 OR ComputerType% < 0 THEN
  66.         ComputerType% = 0
  67.     END IF
  68.     CompId%=ComputerType%
  69. END FUNCTION
  70.  
  71. 'Reverse is a routine I wrote for PB Tools to reverse a string
  72. 'a very simple routine that comes in handy.
  73.  
  74. 'Reverse - Reverse the charactors in a string
  75.  
  76. FUNCTION Reverse$(S$) PUBLIC
  77.     FOR I%=LEN(S$) to 1 STEP  - 1
  78.        Tmp$=Tmp$+MID$(S$,I%,1)
  79.     NEXT I%
  80.     Reverse$=Tmp$
  81. END FUNCTION
  82.  
  83. 'Month$ - Returns the name of a month when given numeric value
  84. 'written by Berry Erick for TB, modified for PB by myself.
  85.  
  86. FUNCTION Month$(mnth%)
  87.    IF mnth%=1 then mn$="January"
  88.    IF mnth%=2 then mn$="February"
  89.    IF mnth%=3 then mn$="March"
  90.    IF mnth%=4 then mn$="April"
  91.    IF mnth%=5 then mn$="May"
  92.    IF mnth%=6 then mn$="June"
  93.    IF mnth%=7 then mn$="July"
  94.    IF mnth%=8 then mn$="August"
  95.    IF mnth%=9 then mn$="September"
  96.    IF mnth%=10 then mn$="October"
  97.    IF mnth%=11 then mn$="November"
  98.    IF mnth%=12 then mn$="December"
  99.    Mnth$=Mn$
  100. END FUNCTION
  101.  
  102. 'Weekday$ - Returns day of the week for current date
  103. 'written by Berry Erick for TB, modified for PB by myself
  104.  
  105. FUNCTION Weekday$(wkdy%)
  106.    IF wkdy%=0 then wk$="Sunday"
  107.    IF wkdy%=1 then wk$="Monday"
  108.    IF wkdy%=2 then wk$="Tuesday"
  109.    IF wkdy%=3 then wk$="Wednesday"
  110.    IF wkdy%=4 then wk$="Thursday"
  111.    IF wkdy%=5 then wk$="Friday"
  112.    IF wkdy%=6 then wk$="Saturday"
  113.    Weekday$=Wk$
  114. END FUNCTION
  115.  
  116. 'DayWeek% - Returns the day of the week (1-7) for the current date
  117. 'Idea from Berry Erick, written by myself
  118.  
  119. FUNCTION DayWeek%(Dat$)
  120.    Temp$=DATE$
  121.    DATE$=Dat$
  122.    REG 1, &h2A00
  123.    DayWeek%=REG(1) MOD 256
  124.    DATE$=Temp$
  125. END FUNCTION
  126.  
  127. 'GetTodaysDate - Returns the current date
  128. 'written by Berry Erick, modified for PB by myself.
  129.  
  130. SUB GetTodaysDate (wk$, dm$, mn$, yr$)
  131.    REG 1, &H2A00
  132.    wkdy%= REG(1) MOD 256
  133.    date%= REG(4) MOD 256
  134.    Mnth%=REG(4)\256
  135.    year%= REG(3)
  136.    wk$=Weekday$(wkdy%)
  137.    SELECT CASE date%
  138.           CASE 1,21,31
  139.                dm$=STR$(date%)+"st"
  140.           CASE 3,23
  141.                dm$=STR$(date%)+"rd"
  142.           CASE 2,22
  143.                dm$=STR$(date%)+"nd"
  144.           CASE ELSE
  145.                dm$=STR$(date%)+"th"
  146.    END SELECT
  147.    mn$=Month$(mnth%)
  148.    yr$=RIGHT$(STR$(year%),4)
  149. END SUB
  150.  
  151. 'Min% - Returns time in minutes from midnight
  152. 'written by Dave Navarro
  153.  
  154. FUNCTION Min%(Tim$)
  155.    Min%=VAL(LEFT$(Tim$,2))*60+VAL(MID$(Tim$,4,2))
  156. END FUNCTION
  157.  
  158. 'Elapsed% - Returns the number of minutes elapsed between two times
  159. 'written by Dave Navarro
  160.  
  161. FUNCTION Elapsed%(Tim1$, Tim2$)
  162.    Tim1%=Min%(Tim1$)
  163.    Tim2%=Min%(Tim2$)
  164.    IF Tim2%<Tim1% THEN Tim2%=Tim2%+1440
  165.    Elapsed%=Tim2%-Tim1%
  166. END FUNCTION
  167.  
  168. 'All mouse routines were derived from code for Turbo C found in "Programming
  169. ' the Microsoft Mouse" from MS Press
  170.  
  171. 'IsMouse - Returns whether or not a mouse is installed and how many buttons
  172. 'written by Dave Navarro
  173.  
  174. FUNCTION IsMouse% PUBLIC
  175.    REG 1, &h00
  176.    CALL INTERRUPT &h33
  177.    Stat%=REG(1)
  178.    Bttn%=REG(2)
  179.    IF Bttn%=-1 THEN Bttn%=2
  180.    IF Stat% THEN IsMouse%=Bttn%
  181. END FUNCTION
  182.  
  183. 'MouseOn - Turn mouse cursor on
  184. 'written by Dave Navarro
  185.  
  186. SUB MouseOn PUBLIC
  187.    REG 1, &h01
  188.    CALL INTERRUPT &h33
  189. END SUB
  190.  
  191. 'MouseOff - Turn mouse curson off
  192. 'written by Dave Navarro
  193.  
  194. SUB MouseOff PUBLIC
  195.    REG 1, &h02
  196.    CALL INTERRUPT &h33
  197. END SUB
  198.  
  199. 'MouseStat - Return button pressed and current row & column position of cursor
  200. '            Left button - 1, Right button - 2, Middle button - 4
  201. 'written by Dave Navarro
  202.  
  203. SUB MouseStat(Button%,Row%,Col%) PUBLIC
  204.    REG 1, &h03
  205.    CALL INTERRUPT &h33
  206.    Button%=REG(2)
  207.    Row%=REG(4)/8+1
  208.    Col%=REG(3)/8+1
  209. END SUB
  210.  
  211. 'MLocate - Locates the mouse cursor at Row, Col
  212. 'written by Dave Navarro
  213.  
  214. SUB MLocate(Row%, Col%) PUBLIC
  215.    REG 1, &h04
  216.    REG 3, Col%*8-8
  217.    REG 4, Row%*8-8
  218.    CALL INTERRUPT &h33
  219. END SUB
  220.  
  221. 'MouseWin - defines window for mouse cursor
  222. 'written by Dave Navarro
  223.  
  224. SUB MouseWin(Row%, Col%, Rows%, Cols%) PUBLIC
  225.    Rows%=Row%+Rows%-1
  226.    Cols%=Col%+Cols%-1
  227.    REG 1, &h08
  228.    REG 3, Row%*8
  229.    REG 4, Rows%*8
  230.    CALL INTERRUPT &h33
  231.    REG 1, &h07
  232.    REG 3, Col%*8
  233.    REG 4, Cols%*8
  234.    CALL INTERRUPT &h33
  235.    CALL MLocate(Row%, Col%)
  236. END SUB
  237.  
  238. 'Trim - Trims spaces from both ends of a string
  239. 'written by Dave Navarro
  240.  
  241. FUNCTION Trim$(T$) PUBLIC
  242.     T$=LTRIM$(T$)
  243.     Trim$=RTRIM$(T$)
  244. END FUNCTION
  245.  
  246. 'FFeed - Send a formfeed to the printer
  247. 'written by Dave Navarro
  248.  
  249. SUB FFeed PUBLIC
  250.    LPRINT CHR$(12)
  251. END SUB
  252.  
  253. ' CvtDate$  - Convert a date from mm-dd-yy format to mm-dd-yyyy format
  254. 'written by Dave Navarro
  255.  
  256. FUNCTION CvtDate$(Tmp$) PUBLIC
  257.      CvtDate$=LEFT$(Tmp$,6)+"19"+RIGHT$(Tmp$,2)
  258. END FUNCTION
  259.  
  260. 'Found on CIS in the TB conference
  261. ' Comment : Compaq 386 machines have the date offset by one.
  262. '           Substitute &HFFF5 to &HFFFC in that case.
  263.  
  264. FUNCTION RomDate$ STATIC
  265.   LOCAL Temp$
  266.   DEF SEG = &HF000
  267.   RomDate$ = PEEK$(&hFFF5, 10)
  268.   DEF SEG
  269. END FUNCTION
  270.  
  271. 'PrtScrn - simulates pressing PrtSc
  272. 'written by Dave Navarro
  273.  
  274. SUB PrtScrn STATIC
  275.     CALL INTERRUPT 5
  276. END SUB
  277.  
  278. 'DPOS - returns the cursor column according to DOS (works with ANSI)
  279. 'written by Dave Navarro
  280.  
  281. FUNCTION DPOS%
  282.     REG 1,&H0300
  283.     REG 2,&H0000
  284.     CALL INTERRUPT &H10
  285.     DPOS%=(REG(4) AND &H00FF)+1
  286. END FUNCTION
  287.  
  288. 'DCSRLIN - returns the cursor line according to DOS (works with ANSI)
  289. 'written by Dave Navarro
  290.  
  291. FUNCTION DCSRLIN%
  292.     REG 1,&H0300
  293.     REG 2,&H0000
  294.     CALL INTERRUPT &H10
  295.     DCSRLIN%=(REG(4) AND &HFF00)/256+1
  296. END FUNCTION
  297.  
  298. 'DPrint - Prints a text string via DOS, works with ANSI
  299. 'written by Dave Navarro
  300. 'WARNING!!  will not print dollar signs, if a dollar sign is encountered
  301. 'you will need to use DOS's princhar command instead of princhars
  302.  
  303. SUB Dprint(Temp$)
  304.    Temp$=Temp$+"$"
  305.    REG 1,&h0900
  306.    REG 8,STRSEG(Temp$)
  307.    REG 4,STRPTR(Temp$)
  308.    CALL INTERRUPT &h21
  309. END SUB
  310.  
  311. 'CurDrive% - Returns current logged drive
  312. 'written by Dave Navarro
  313.  
  314. FUNCTION CurDrive% PUBLIC
  315.    CurDrive%=ASC(CurDir$)-64
  316. END FUNCTION
  317.  
  318. 'Exist - Returns true if file exists
  319. 'written by Dave Navarro
  320.  
  321. FUNCTION Exist%(File$) PUBLIC
  322.    Tmp$=DIR$(File$,&H17)
  323.    IF Tmp$<>"" THEN Exist%=-1
  324. END FUNCTION
  325.  
  326. 'VLabel - Returns Volume Label
  327. 'written by Dave Navarro
  328.  
  329. FUNCTION VLabel$ PUBLIC
  330.    VLabel$=DIR$("*.*",8)
  331. END FUNCTION
  332.